home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 49 / Amiga Format CD49 (2000-01-17)(Future Publishing)(GB)(Track 1 of 3)[!][issue 2000-02].iso / -serious- / misc / shellscr / src / shellscr.e < prev   
Text File  |  1999-11-30  |  12KB  |  383 lines
  1. -> ShellScr v1.6 by Kyzer/CSG
  2. -> Creates a fullscreen shell with it's own public screen
  3. -> $VER: ShellScr.e 1.6 (15.09.99)
  4.  
  5. OPT PREPROCESS,OSVERSION=37
  6.  
  7. MODULE    'asl', 'diskfont', 'dos/dos', 'dos/dosextens', 'dos/dostags',
  8.     'exec/lists', 'exec/nodes', 'graphics/displayinfo', 'graphics/modeid',
  9.     'graphics/text', 'intuition/intuition', 'intuition/screens',
  10.     'libraries/asl', 'locale', 'utility/tagitem', 'workbench/startup',
  11.     '*args', '*clr', '*defarg', '*locale', '*paths'
  12.  
  13. DEF aslbase=NIL
  14.  
  15. -> make shortcut to getting locale strings
  16. #define c(x) get_str(catalog, x)
  17.  
  18. #define DEF_CONSPEC \
  19.  'CON:\s//BACKDROP/NOBORDER/NOSIZE/NODRAG/NODEPTH/NOCLOSE/SCREEN\s'
  20.  
  21. #define DEF_CONSPEC_LEN 71
  22.  
  23. #define TEMPLATE \
  24.  'PUBNAME=NAME,MODEID=ID,DEPTH/N,FONT/K,AUTOSCROLL/S,'+\
  25.  'SHANGHAI/S,SCREENTITLE=TITLE,NOTITLE=HIDETITLE/S,'+\
  26.  'CONSPEC=WINDOW,COMMANDFILE=FROM,STACKSIZE=STACK/N'
  27.  
  28. OBJECT myargs
  29.   pubname    -> chosen public screen name or NIL
  30.   modeid    -> string referencing mode-id or NIL
  31.   depth        -> ptr to LONG number or NIL: depth of screen
  32.   font        -> ptr to font description ('fontname/size') or NIL
  33.   autoscroll    -> boolean, true (default) = AUTOSCROLL screen
  34.   shanghai    -> boolean, true = SHANGHAI mode enabled
  35.  
  36.   title        -> string: name of titlebar or NIL
  37.   notitle    -> boolean, zero = show titlebar, non-zero = hide titlebar
  38.  
  39.   conspec    -> WINDOW parameter of NewShell
  40.   cmdfile    -> FROM parameter of NewShell
  41.  
  42.   stacksize     -> ptr to LONG number or NIL: size of stack
  43. ENDOBJECT
  44.  
  45. DEF args:myargs, sig=-1, pubname[32]:STRING, catalog=NIL
  46.  
  47. RAISE "MEM" IF String()=NIL
  48. RAISE "SYS" IF SystemTagList()<>0
  49. RAISE "def" IF LockPubScreen()=NIL
  50. RAISE "sig" IF AllocSignal()=-1
  51.  
  52.  
  53. ->-----------------------------------------------------------------------------
  54.  
  55.  
  56. PROC main() HANDLE
  57.   DEF wbmsg:PTR TO wbstartup, rdargs=NIL, olddir, dir=NIL,
  58.       screen=NIL, command, depth=2, stack
  59.  
  60.   -> choose reasonable start directory when launched from Workbench
  61.   IF wbmsg := wbmessage
  62.     IF dir := DupLock(
  63.       IF wbmsg.numargs > 1 THEN wbmsg.arglist[1].lock ELSE GetProgramDir()
  64.     ) THEN olddir := CurrentDir(dir)
  65.   ENDIF
  66.  
  67.   -> initialise localization
  68.   IF localebase := OpenLibrary('locale.library', 38)
  69.     catalog := OpenCatalogA(NIL, 'shellscr.catalog', NIL)
  70.   ENDIF
  71.  
  72.   -> initialise argarray
  73.   clr(args, SIZEOF myargs)
  74.   args.pubname := StringF(pubname, c(MSG_DEF_PUBNAME), FindTask(NIL))
  75.   args.depth   := {depth}
  76.  
  77.   -> read arguments with fabulous wb-friendly readargs()
  78.   IF (rdargs := readargs(TEMPLATE, args, wbmsg)) = NIL THEN Raise("args")
  79.  
  80.   -> open the screen, and construct the required arguments
  81.   command := makecmd(screen := openscr())
  82.  
  83.   -> run the NewShell command to open a new command.
  84.   stack := Max(1600, IF args.stacksize THEN Long(args.stacksize) ELSE 4096)
  85.  
  86.   SystemTagList(command, NEW [
  87.     NP_PATH,       getpath(),
  88.     NP_STACKSIZE,  stack + 3 AND -4,
  89.     SYS_USERSHELL, TRUE,
  90.     SYS_ASYNCH,    FALSE,
  91.     TAG_DONE
  92.   ])
  93.  
  94.   REPEAT
  95.     Wait(Shl(1, sig) OR SIGBREAKF_CTRL_C)
  96.   UNTIL CloseScreen(screen)
  97.   screen := NIL
  98.  
  99. EXCEPT DO
  100.   -> Errors that deserve an error message to the user are processed here
  101.   SELECT exception
  102.  
  103.    -> couldn't allocate memory for strings or such
  104.   CASE "MEM";  msg(error(ERROR_NO_FREE_STORE))
  105.  
  106.   -> System() failed
  107.   CASE "SYS";  msg(error(0, c(MSG_NEWSHELL_FAILED)))
  108.  
  109.   -> ReadArgs() failed
  110.   CASE "args"; msg(error(0, c(MSG_BAD_ARGS)))
  111.  
  112.   -> LockPubScreen() failed
  113.   CASE "def";  msg(c(MSG_NO_DEF_SCREEN))
  114.  
  115.   -> OpenScreen() failed
  116.   CASE "scr";  exceptioninfo := c(IF (exceptioninfo < 0) OR (exceptioninfo > 7) THEN MSG_UNKNOWN_ERROR ELSE MSG_SCREENERROR + exceptioninfo)
  117.                msg(c(MSG_SCREEN_ERROR), {exceptioninfo})
  118.   ENDSELECT
  119.  
  120.   -> cleanup
  121.  
  122.   IF screen
  123.     REPEAT; UNTIL CloseScreen(screen)
  124.     SetDefaultPubScreen(NIL)
  125.   ENDIF
  126.  
  127.   IF dir       THEN UnLock(CurrentDir(olddir))
  128.   IF rdargs    THEN FreeArgs(rdargs)
  129.   IF sig <> -1 THEN FreeSignal(sig)
  130.  
  131.   IF localebase THEN CloseCatalog(catalog)
  132.   CloseLibrary(localebase)
  133.  
  134. ENDPROC (IF exception THEN 10 ELSE 0)
  135.  
  136. ->-----------------------------------------------------------------------------
  137.  
  138. PROC makecmd(s:PTR TO screen)
  139.   -> create the 'NewShell' command required to open the shell
  140.   DEF cmd, cmdformat, sizes, top
  141.  
  142.   -> window-size calculation (see guide)
  143.   top := IF args.notitle THEN 0 ELSE IF args.conspec THEN s.barheight+1 ELSE 3
  144.   sizes := StringF(String(24), '\d/\d/\d/\d', 0, top, s.width, s.height-top)
  145.  
  146.   -> generate command formatter :  'NewShell [conspec] [FROM cmdfile]'
  147.   -> conspec contains two '%s' ('\s') formatters for windowsize and screenname
  148.   cmdformat := StringF(
  149.     String(
  150.       9 +
  151.       (IF args.conspec THEN StrLen(args.conspec)   ELSE DEF_CONSPEC_LEN) +
  152.       (IF args.cmdfile THEN StrLen(args.cmdfile)+6 ELSE 0)
  153.     ),
  154.     'NewShell \s\s\s',
  155.     defarg(args.conspec, DEF_CONSPEC),
  156.     IF args.cmdfile THEN ' FROM ' ELSE '',
  157.     defarg(args.cmdfile, '')
  158.   )
  159.  
  160.   -> create final command from format template
  161.   cmd := StringF(
  162.     String(EstrLen(cmdformat) + EstrLen(sizes) + StrLen(args.pubname)),
  163.     cmdformat, sizes, args.pubname
  164.   )
  165. ENDPROC cmd
  166.  
  167.  
  168. ->-----------------------------------------------------------------------------
  169.  
  170. PROC openscr() HANDLE
  171.   -> opens the screen as requested by the user
  172.  
  173.   DEF screen=NIL:PTR TO screen, defscreen=NIL:PTR TO screen,
  174.       drawinfo=NIL:PTR TO drawinfo, errorcode, fontdesc, font
  175.  
  176.   -> Find a default screen to read default information about
  177.   drawinfo := GetScreenDrawInfo(defscreen := LockPubScreen(NIL))
  178.  
  179.   -> get the required font - or copy the default screen's
  180.   fontdesc, font := openfont(defscreen.font)
  181.  
  182.   screen := OpenScreenTagList(NIL, NEW [
  183.     SA_ERRORCODE,   {errorcode},
  184.  
  185.     -> tags defining the public nature of our screen
  186.     SA_PUBNAME,     args.pubname,
  187.     SA_PUBSIG,      sig := AllocSignal(-1),
  188.     SA_PUBTASK,     FindTask(NIL),
  189.     SA_TYPE,        PUBLICSCREEN,
  190.  
  191.     SA_DISPLAYID,   getmode(args.modeid, GetVPModeID(defscreen.viewport)),
  192.     SA_DEPTH,       Long(args.depth),
  193.     SA_FONT,        fontdesc,
  194.     SA_AUTOSCROLL,  args.autoscroll,
  195.  
  196.     SA_TITLE,       defarg(args.title, c(MSG_DEF_TITLE)),
  197.     SA_SHOWTITLE,   (args.notitle = FALSE),
  198.  
  199.     SA_PENS,        IF drawinfo THEN drawinfo.pens ELSE [-1]:INT,
  200.     SA_FULLPALETTE, TRUE,
  201.  
  202.     TAG_DONE
  203.   ])
  204.  
  205.   IF screen = NIL THEN Throw("scr", errorcode)
  206.  
  207.   -> make screen go public, also make it the default pubscreen
  208.   PubScreenStatus(screen, PUBLICSCREEN)
  209.   SetDefaultPubScreen(args.pubname)
  210.  
  211.   -> enable Shanghai mode if user wants this
  212.   IF args.shanghai THEN SetPubScreenModes(SHANGHAI OR SetPubScreenModes(0))
  213.  
  214. EXCEPT DO
  215.   IF font      THEN CloseFont(font)
  216.   IF drawinfo  THEN FreeScreenDrawInfo(defscreen, drawinfo)
  217.   IF defscreen THEN UnlockPubScreen(NIL, defscreen)
  218.  
  219.   CloseLibrary(diskfontbase)
  220.   CloseLibrary(aslbase)
  221.  
  222.   ReThrow()
  223. ENDPROC screen
  224.  
  225. ->----
  226.  
  227. PROC openfont(deffont:PTR TO textattr)
  228.   DEF fontdesc=NIL:PTR TO textattr, font=NIL:PTR TO textfont, name, size
  229.  
  230.   -> find out the real name/size of our requested (or not) font
  231.   name, size := getfont(args.font)
  232.  
  233.   -> if a certain font has been decided, then open it from disk
  234.   IF name
  235.     IF diskfontbase := OpenLibrary('diskfont.library', 37)
  236.       IF font := OpenDiskFont(fontdesc := NEW [name, size, 0, 0]:textattr)
  237.  
  238.         -> tsssk the user if he picked a proportional font
  239.         IF font.flags AND FPF_PROPORTIONAL THEN msg(c(MSG_PROPFONT), fontdesc)
  240.       ENDIF
  241.     ENDIF
  242.   ELSE
  243.     -> only copy default font if it is fixed-width
  244.     IF (deffont.flags AND FPF_PROPORTIONAL)=0
  245.       CopyMem(deffont, NEW fontdesc, SIZEOF textattr)
  246.       fontdesc.name := StrCopy(String(StrLen(fontdesc.name)), fontdesc.name)
  247.     ENDIF
  248.   ENDIF
  249. ENDPROC fontdesc, font
  250.  
  251. ->----
  252.  
  253. PROC getfont(fontname)
  254.   -> process font-string (eg 'topaz/11', 'lcd.10', 'flyspeck', '?') and return
  255.   -> proper name and size ('topaz.font',11, 'lcd.font',10 ...)
  256.  
  257.   DEF font=NIL, size=8, req:PTR TO fontrequester, valid, n
  258.  
  259.   IF fontname = NIL THEN RETURN NIL
  260.  
  261.   -> ASL font requester if fontname="?" or fontname=""
  262.   IF (StrCmp(fontname, '?') OR StrCmp(fontname, ''))
  263.     IF openasl()
  264.       IF req := AllocAslRequest(ASL_FONTREQUEST, NIL)
  265.         IF AslRequest(req, [ASLFO_FIXEDWIDTHONLY, TRUE, TAG_DONE])
  266.           font := StrCopy(String(StrLen(req.attr.name)), req.attr.name)
  267.           size := req.attr.ysize
  268.         ENDIF
  269.         FreeAslRequest(req)
  270.       ENDIF
  271.     ENDIF
  272.   ELSE
  273.     -> copy fontname so we can (perhaps) modify it
  274.     StrCopy(font := String(StrLen(fontname)+5), fontname)
  275.  
  276.     -> look for and remove size from string
  277.     -> (in 'myfont/99' or 'myfont.99' format)
  278.     IF (n := InStr(font, '/')) = -1 THEN n := InStr(font, '.')
  279.     IF n <> -1
  280.       -> get size from string (or 8 as default)
  281.       size, valid := Val(font+n+1)
  282.       IF valid = FALSE THEN size := 8
  283.  
  284.       -> remove size part from string
  285.       font[n] := "\0" -> can we guarantee SetStr() to do this?
  286.       SetStr(font, n)
  287.     ENDIF
  288.  
  289.     -> add '.font' to name if neccessary
  290.     IF InStr(font, '.font') = -1 THEN StrAdd(font, '.font')
  291.   ENDIF
  292. ENDPROC font, size
  293.  
  294. ->----
  295.  
  296. PROC getmode(modename, defmode)
  297.   -> process string with some form of mode name in it, and return a numeric ID
  298.   -> string can take the form of:
  299.   -> '' or '?' (cause user choice from ASL screenmode requester)
  300.   -> 'PAL:High Res' (named graphic mode)
  301.   -> '12345678' (decimal for compatibility with ShellScr 1.2 and previous
  302.   -> '0x29000' (hexadecimal spec with C-style number)
  303.   -> '$29000' (hexadecimal spec with asm-style number)
  304.   -> if parsing fails, it returns the default mode supplied
  305.  
  306.   DEF modeid, req:PTR TO screenmoderequester, ok, valid, dh, ni:nameinfo
  307.  
  308.   IF modename = NIL THEN RETURN defmode
  309.  
  310.   -> ASL screenmode requester when modename='?' or ''
  311.   IF (StrCmp(modename, '?') OR StrCmp(modename, ''))
  312.     IF openasl()
  313.       IF req := AllocAslRequest(ASL_SCREENMODEREQUEST, NIL)
  314.         ok := AslRequest(req, NEW [
  315.           ASLSM_DOAUTOSCROLL,       TRUE,
  316.           ASLSM_DODEPTH,            TRUE,
  317.           ASLSM_INITIALAUTOSCROLL,   args.autoscroll,
  318.           ASLSM_INITIALDISPLAYDEPTH, Long(args.depth),
  319.           ASLSM_INITIALDISPLAYID,    defmode,
  320.           TAG_DONE
  321.         ])
  322.         FreeAslRequest(req)
  323.  
  324.         IF ok = FALSE THEN Raise("canc") -> 'cancelled requester' exception
  325.  
  326.         PutLong(args.depth, req.displaydepth)
  327.         args.autoscroll := req.autoscroll
  328.  
  329.         modeid := req.displayid
  330.         msg(c(MSG_MODEID), {modeid})
  331.         RETURN modeid
  332.       ENDIF
  333.     ENDIF
  334.   ENDIF
  335.  
  336.   -> compare modename against all named screenmodes in the display database
  337.  
  338.   modeid := INVALID_ID
  339.   WHILE (modeid := NextDisplayInfo(modeid)) <> INVALID_ID
  340.     IF (modeid AND MONITOR_ID_MASK)
  341.       dh := FindDisplayInfo(modeid)
  342.       IF GetDisplayInfoData(dh, ni, SIZEOF nameinfo, DTAG_NAME, INVALID_ID)
  343.         IF StrCmp(modename, ni.name) THEN RETURN modeid
  344.       ENDIF
  345.     ENDIF
  346.   ENDWHILE
  347.  
  348.   -> otherwise - a numeric ID.
  349.  
  350.   -> change '0xB1AB1A' into '$B1AB1A'
  351.   IF StrCmp(modename, '0x', 2); INC modename; modename[] := "$"; ENDIF
  352.  
  353.   -> find the value of the ID.
  354.   modeid, valid := Val(modename)
  355. ENDPROC IF valid THEN modeid ELSE defmode
  356.  
  357.  
  358. ->-----------------------------------------------------------------------------
  359. -> handy little things...
  360.  
  361. -> message-printer for WB and shell
  362. PROC msg(msg, args=NIL)
  363.   IF wbmessage
  364.     EasyRequestArgs(NIL, NEW [20, 0, 'ShellScr', msg, c(MSG_OK)], 0, args)
  365.   ELSE
  366.     Vprintf(msg, args); PutStr('\n')
  367.   ENDIF
  368. ENDPROC
  369.  
  370. -> returns string form of DOS Fault. Can prepend header.
  371. PROC error(error=0, header=NIL)
  372.   DEF x
  373.   SetStr(x := String((IF header THEN StrLen(header) ELSE 0) + FAULT_MAX + 2),
  374.     Fault(defarg(error, IoErr()), header, x, StrMax(x))
  375.   )
  376. ENDPROC x
  377.  
  378. -> open asl.library only once
  379. PROC openasl() IS defarg(aslbase, aslbase := OpenLibrary('asl.library', 38))
  380.  
  381.  
  382. CHAR '$VER: ShellScr 1.6 (15.09.99)'
  383.